perm filename PT2D.3[RST,LCS] blob
sn#243214 filedate 1976-10-20 generic text, type C, neo UTF8
COMMENT ā VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 SUBROUTINE PT2
C00009 ENDMK
Cā;
SUBROUTINE PT2
INTEGER VALID
DIMENSION VALID(6),BARS(509)
DATA QLINE/140.0/,HX/2./,VALID/1,4,8,2,3,-2/,SLSP/11.0/,DIV/4./
C QLINE=BASIC LINE LENGTH, HX=HEIGHT MULTIPLIER, ZL=LN. LNGTH FACTOR.
C ADD MORE TO VALID LATER *****
COMMON /FIN/JBAR,METR,REND,KPX,KREAD,JEND,JSLUR,JSL2,NAMZ
1,LC,LPG,MPG,CLEF,SIG,LB,SPG,MTR1,MTR2
COMMON /SF/KL,RT,KP,STFSZ,NAMX /IPG/IPG,JPG,BRACK,
1 RSTNUM(8),RPSZ(8),RHGT(8),RCLEF(-3/4) /KBAR/KBAR(512)
1 /RSP/KNM(10),ENDLN,N,NAME,NMPG,T
COMMON RS,JA,CLEFQ,AA,RQ(16),KQ,NQ,JQ,JJQ,KBQ,NAQ
COMMON/STF/RSTFAC(-3/4),RSTJ2 /IVV/IV(1) /SIZE/SIZE
COMMON /POSI/STFF(-3/4),JJ2,JPQ /LLL/L,LL,I,RXQ
1/PX/KPN(1) /Q/Q(1) /PTR/KWDS(1) /XRN/RN(1) /NBAR/NBAR(36)
EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(KT,KBAR)
1,(R8,RQ(6)),(R9,RQ(7)),(LCNT,IV(80)),(NDPY,IV(81)),(TOT,KBAR(2))
1,(BARS,KBAR(4))
CC 1,(RSTF,RSTFAC(100))
C TRNSP'S Bb, F, BBb, A, G, Eb.
55 FORMAT(F,2I)
CCC IF(RS.NE.'OLD')GO TO 2000
CALL GETFIL('BARS')
CALL FASTIN(KBAR,512)
CALL FASTIN(RSTFAC,128)
2000 TYPE 144
144 FORMAT(' STAFF SIZE, TRANSP. '$)
ACCEPT 55,SIZE,LL
IF(SIZE.NE.0)GO TO 101
SIZE=1
GO TO 33
101 DO 22 K=1,KT
22 BARS(K)=BARS(K)*SIZE
TOT=TOT*SIZE
33 IF(RSTJ2.EQ.0)RSTJ2=1
RA=JPG*SIZE*RSTJ2
MPG=10./RA
C MPG=NUM OF BRACES PER PAGE.
SPG=10./MPG
C SPG IS SPACE TO BE SET ABOVE STAFF 0
RA=(RSTJ2*SIZE)/RPSZ(1)
DO 141 K=1,JPG
141 RPSZ(K)=RPSZ(K)*RA
LPG=JPG
IF(MOD(LL,7).EQ.0)GO TO 140
DO 40 L=1,6
40 IF(LL.EQ.VALID(L))GO TO 140
TYPE 240
GO TO 2000
240 FORMAT(' THIS TRANSP NOT OFFERED')
140 TYPE 90,KT
RA=0
90 FORMAT(' TOTAL BAR LINES='I3/' NUMBER OF BARS PER LINE')
JT=TOT/QLINE
C USE QLINE (140 FOR NOW) AS SUGGESTED LINE LENGTH
T=JT
16 AV=TOT/T
XAV=AV*.8
JT=T
C JT=TOTAL NUM OF LINES
ODIF=10000
RN(1)=0
C KT=NUM OF BARS
NBAR(1)=1
JA=KT-JT+1
DO 3 K=1,JA
3 RN(1)=RN(1)+BARS(K)
DO 1 K=2,JT
JA=JA+1
NBAR(K)=JA
1 RN(K)=BARS(JA)
NBAR(JT+1)=KT+1
4 IF(LAST)GO TO 46
RMIN=10000
RMAX=0
JMIN=0
JMAX=0
DO 44 K=1,JT
X=RN(K)
IF(X.GE.RMIN)GO TO 45
RMIN=X
JMIN=K
45 IF(X.LE.RMAX)GO TO 44
RMAX=X
JMAX=K
C FINDS MIN. AND MAX. LINE LENGTHS. (GETS POINTERS TOO.)
44 CONTINUE
RDIF=RMAX-RMIN
IF(RDIF.GT.ODIF)GO TO 46
CC IF(RDIF.GT.ODIF)LAST=-1
C ODIF SHOULD ALWAYS GET SMALLER - TIL LAST TIME.
ODIF=RDIF
C RIPPLE IT IF NECESSARY
IF(JMAX.GT.JMIN)GO TO 7
C NEXT IS FOR MAX. LINE LENGTH PRECEDING MIN.
JA=JMAX+1
JB=JMIN
JC=1
JD=-1
JE=-1
JF=0
200 DO 20 K=JA,JB,JC
X=BARS(NBAR(K)+JE)
NBAR(K)=NBAR(K)+JD
RN(K+JF)=RN(K+JF)+X
20 RN(K+JE)=RN(K+JE)-X
GO TO 4
7 JA=JMAX
JB=JMIN+1
JC=-1
JD=1
JE=0
JF=-1
GO TO 200
46 DO 21 K=JA,JB,JC
C MOVE THINGS BACK TO THE WAY THEY WERE BEFORE 'LAST'.
X=BARS(NBAR(K)+JE)
NBAR(K)=NBAR(K)-JD
RN(K+JF)=RN(K+JF)-X
21 RN(K+JE)=RN(K+JE)+X
J=1
TYPE 306,AV
DO 305 K=1,JT
NBAR(K)=NBAR(K+1)-NBAR(K)
C NBAR NOW HAS NUM. OF BARS PER LINE.
L=NBAR(K)-1+J
T=0
DO 18 M=J,L
18 T=T+BARS(M)
306 FORMAT(1XF4.0,3X8F4.0)
TYPE 306,T,(BARS(N),N=J,L)
305 J=L+1
RPG=JT
RPG=RPG/MPG
105 TYPE 104,RPG,JT
104 FORMAT(F5.2,' PAGES',/,I4,' LINES - OR TYPE N1, N2 --'$)
C FOR SPECIFICATION OF HOW MANY BARS ON EACH LINE
KA=0
ACCEPT 55,T,N,KL
C TYPE 0,n TO EXIT WITH n SPACING BETWEEN STAVES (2 IS DEFAULT)
IF(KL.NE.0)GO TO 110
C NO MORE THAN 36 NUMS, INCLUDING 0S (FOR PAGE MARKS)
IF(T.EQ.0)GO TO 11
JT=T
IF(N.EQ.0)GO TO 16
C N=0 MEANS T= NUM OF LINES DESIRED.
111 FORMAT(36I)
110 REREAD 111,NBAR
911 DO 112 K=36,1,-1
KP=NBAR(K)
KA=KA+KP
112 IF(KP.EQ.0.AND.KA.EQ.0)KL=K
IF(KA.NE.KT)GO TO 105
C MISMATCH!
N=26-2*MOD(KL-1,12)
IF(N.EQ.26)N=0
C TO SPACE OUT STAVES VERTICALLY
CC IF(IPG)GO TO 11
CC IF(NBAR(1).NE.0)GO TO 11
CC DO 711 K=1,36
CC IF(K.GT.J)IV(K)=0
CC711 NBAR(K)=IV(K)
CC GO TO 911
11 CALL WRTPAG
END